# Figure_3.R
# John G. Bullock (john@johnbullock.org)
# 2016 August 02

# This file creates Figure 3 in 
#   Gertler, Aaron L., and John G. Bullock.  2016.  "Reference Rot: An 
#   Emerging Threat to Transparency in Political Science."  PS: Political 
#   Science and Politics.

library(grid)
filenameStem         <- 'Figure_3'  # 'persistentIdentifiers'
PDFtitle             <- 'The Logic of Persistent Identifiers'  
PS_width             <- 6.5
PS_height            <- 4.75
postscriptBackground <- 'transparent'


# We need to draw line segments (arrows) that connect two circles.  The lines 
# should look naturally positioned, instead of all stemming from, say, the 
# bottom-center of each of the top circles.  One way to make the lines look 
# more natural is to position them so that they are as short as possible while
# still connecting the circles.  This code does that.
#   Keys to remember: cos(x) gives the x-coordinates of a point in the unit 
# circle that has angle x (in radians).  sin (x) gives the y-coordinates.
degreesToRadians <- function (d) d * pi / 180
radiansToDegrees <- function (r) r * 180 / pi
upperAngle       <- function (rise, run, reportDegrees = FALSE) {
  # Compute the upper angle, in degrees, of a right triangle whose right angle 
  # is in the lower right-hand corner.  
  angle <- atan2(rise, run)
  if (reportDegrees) angle <- radiansToDegrees(angle)
  angle
} 
arrowUpperCoord <- function (  
  coord,
  upperOrLower,
  upperCircleCenterX, 
  upperCircleCenterY, 
  lowerCircleCenterX, 
  lowerCircleCenterY, 
  radius,
  angle = NULL,
  valueOnly = TRUE) {

  # Get everything into NPC units
  if (! 'unit' %in% class(upperCircleCenterX)) upperCircleCenterX <- unit(upperCircleCenterX, "npc")
  else upperCircleCenterX <- convertWidth(upperCircleCenterX, "npc")
  if (! 'unit' %in% class(lowerCircleCenterX)) lowerCircleCenterX <- unit(lowerCircleCenterX, "npc")
  else lowerCircleCenterX <- convertWidth(lowerCircleCenterX, "npc")
  if (! 'unit' %in% class(upperCircleCenterY)) upperCircleCenterY <- unit(upperCircleCenterY, "npc")
  else upperCircleCenterY <- convertHeight(upperCircleCenterY, "npc")
  if (! 'unit' %in% class(lowerCircleCenterY)) lowerCircleCenterY <- unit(lowerCircleCenterY, "npc")
  else lowerCircleCenterY <- convertHeight(lowerCircleCenterY, "npc")
  if (! 'unit' %in% class(radius)) radius <- unit(radius, "npc")
  else if (coord == 'x') radius <- convertWidth(radius, "npc")
  else if (coord == 'y') radius <- convertHeight(radius, "npc")
  
  # Do the calculations  
  if (upperOrLower == 'upper') {
    rise  <- as.numeric(convertHeight(lowerCircleCenterY - upperCircleCenterY, "npc"))
    run   <- as.numeric(convertWidth(lowerCircleCenterX - upperCircleCenterX, "npc"))
  } else if (upperOrLower == 'lower'){
    rise  <- as.numeric(convertHeight(upperCircleCenterY - lowerCircleCenterY, "npc"))
    run   <- as.numeric(convertWidth(upperCircleCenterX - lowerCircleCenterX, "npc"))    
  }
  if (is.null(angle)) {
    angle <- upperAngle(rise, run)
  }
  if (upperOrLower == 'upper') {
    if (coord == 'x')      convertWidth (upperCircleCenterX + radius*cos(angle), "npc", valueOnly)
    else if (coord == 'y') convertHeight(upperCircleCenterY + radius*sin(angle), "npc", valueOnly)
  } else if (upperOrLower == 'lower') {
    if (coord == 'x')      convertWidth (lowerCircleCenterX + radius*cos(angle), "npc", valueOnly)
    else if (coord == 'y') convertHeight(lowerCircleCenterY + radius*sin(angle), "npc", valueOnly)    
  }
}
arrowUpperX <- function(...) {
  arrowUpperCoord(coord = 'x', upperOrLower = 'upper', ...)
}
arrowUpperY <- function(...) {
  arrowUpperCoord(coord = 'y', upperOrLower = 'upper', ...)
}
arrowLowerX <- function(...) {
  arrowUpperCoord(coord = 'x', upperOrLower = 'lower', ...)
}
arrowLowerY <- function(...) {
  arrowUpperCoord(coord = 'y', upperOrLower = 'lower', ...)
}

arrowLowerY(
  1, 
  1, 
  1, 
  0,
  radius = .2,
  angle = pi/2)



##############################################################################
# DRAW THE FIGURE
##############################################################################
setwd('figureOutput/')
pdf(
  file   = paste0(filenameStem, '.pdf'), 
  width  = PS_width, 
  height = PS_height, 
  paper  = "special", 
  title  = PDFtitle,
  bg     = postscriptBackground)

circleRadius               <- unit(.20, "inches") 
topCircleLabel             <- 'URL'
topCircleLabelY            <- unit(1, "npc") - circleRadius
topCircleLabelCex          <- .700 
arrowTop                   <- topCircleLabelY - circleRadius
arrowTipLength             <- unit(.075, "inches") 
resourceCircleLabelX.L     <- unit(.250, "npc")
resourceCircleLabelX.R     <- unit(.750, "npc")
resourceCircleLabelY.lower <- unit(.100, "npc")
changeString               <- 'change in location of online resource'
changeStringSep            <- unit(.095, "inches")  # vertical space above arrow 
changeStringCex            <- .875
changeStringArrowX.L       <- .150
changeStringArrowX.R       <- .850


masterLayout <- grid.layout(
  nrow    = 7, 
  ncol    = 3, 
  heights = unit(c(.175, .2, 1, .575, .175, .2, 1.4), c("inches", "inches", "null", "inches", "inches", "inches", "null")),
  widths  = unit(c(1, .65, 1.0), c("null", "inches", "null")),
  respect = matrix(rep(c(0, 1, 0), 7), nrow = 7, byrow = TRUE))
###
vpU.title <- viewport(
  layout.pos.row = 1, 
  just           = c("center", "bottom"))
vpU.titleSpacer <- viewport(
  layout.pos.row = 2, 
  just           = c("center", "bottom"))
###
vpU <- viewport(
  layout.pos.row = 3, 
  just           = c("center", "center"),
  clip           = "off")  
vpUL <- viewport(
  layout.pos.row = 3, 
  layout.pos.col = 1,
  just           = c("center", "center"))  
vpUR <- viewport(
  layout.pos.row = 3, 
  layout.pos.col = 3,
  just=c("center", "center"))  
###
vpHorizSpacer <- viewport(layout.pos.row = 4, just=c("center", "center"))
###
vpL.title <- viewport(
  layout.pos.row = 5, 
  just           = c("center", "bottom"))
vpL.titleSpacer <- viewport(
  layout.pos.row = 6, 
  just           = c("center", "bottom"))
###
vpL <- viewport(
  layout.pos.row = 7, 
  just           = c("center", "center"),
  clip           = "off")  
vpLL <- viewport(
  layout.pos.row = 7, 
  layout.pos.col = 1,
  just=c("center", "center"))  
vpLR <- viewport(
  layout.pos.row = 7, 
  layout.pos.col = 3,
  just=c("center", "center"))  
pushViewport(viewport(layout = masterLayout))


pushViewport(vpU.title)
  grid.text(
    label = 'WITHOUT A PERSISTENT DIGITAL IDENTIFIER',
    just  = c('center', 'bottom'),
    x     = 0.5,
    y     = 0)
upViewport()

pushViewport(vpUL)
  grid.circle(
    x = c(.2, .4, .6, .8),
    y = rep(topCircleLabelY, 4),
    r = circleRadius)
  grid.text(
    label = paste0('URL ', 1:4),
    x     = c(.2, .4, .6, .8),
    y     = rep(topCircleLabelY, 4),
    gp    = gpar(cex = topCircleLabelCex))
  grid.circle(
    x = resourceCircleLabelX.L,
    y = .2,
    r = circleRadius)
  grid.text(
    label = 'R',
    x = resourceCircleLabelX.L,
    y = .2)
  grid.segments(
    x0 = arrowUpperX(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = resourceCircleLabelX.L,
      lowerCircleCenterY = .2, 
      radius             = circleRadius),  
    x1 = arrowLowerX(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = resourceCircleLabelX.L,
      lowerCircleCenterY = .2, 
      radius             = circleRadius),
    y0 = arrowUpperY(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = resourceCircleLabelX.L,
      lowerCircleCenterY = .2, 
      radius             = circleRadius),  
  y1 <- arrowLowerY(
    upperCircleCenterX = c(.2, .4, .6, .8), 
    upperCircleCenterY = topCircleLabelY, 
    lowerCircleCenterX = resourceCircleLabelX.L,
    lowerCircleCenterY = .2, 
    radius             = circleRadius),  
  arrow = arrow(
    angle  = 15, 
    length = arrowTipLength,
    type   = "closed"),
    gp    = gpar(fill = 'black'))
upViewport()

pushViewport(vpUR)
  grid.circle(
    x = c(.2, .4, .6, .8),
    y = rep(topCircleLabelY, 4),
    r = circleRadius)
  grid.text(
    label = paste0('URL ', 1:4, "'"),
    x     = c(.2, .4, .6, .8),
    y     = rep(topCircleLabelY, 4),
    gp    = gpar(cex = topCircleLabelCex))
  grid.circle(
    x = resourceCircleLabelX.R,
    y = .2,
    r = circleRadius)
  grid.text(
    label = 'R',
    x     = resourceCircleLabelX.R,
    y     = .2)
  grid.segments(
    #x0    = c(.2, .4, .6, .8),
    x0 = arrowUpperX(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = resourceCircleLabelX.R,
      lowerCircleCenterY = .2, 
      radius             = circleRadius),    
    x1 = arrowLowerX(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = resourceCircleLabelX.R,
      lowerCircleCenterY = .2, 
      radius             = circleRadius),    
    y0 = arrowUpperY(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = resourceCircleLabelX.R,
      lowerCircleCenterY = .2, 
      radius             = circleRadius),    
    y1 = arrowLowerY(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = resourceCircleLabelX.R,
      lowerCircleCenterY = .2, 
      radius             = circleRadius),
    arrow = arrow(
      angle  = 15, 
      length = unit(.1, "inches"),
      type   = "closed"),
    gp    = gpar(fill = "black"))  
upViewport()

pushViewport(vpU)
  grid.segments(
    x0 = changeStringArrowX.L,
    x1 = changeStringArrowX.R,
    y0 = .2,
    y1 = .2,
    arrow = arrow(
      angle  = 15, 
      length = arrowTipLength,
      type   = "closed"),
    gp = gpar(fill = "black"))
  grid.text(
    label = changeString,
    x     = .5,
    y     = unit(.2, "npc") + changeStringSep,
    gp    = gpar(cex = changeStringCex))
upViewport()

pushViewport(vpHorizSpacer)
upViewport()

pushViewport(vpL.title)
  grid.text(
    label = 'WITH A PERSISTENT DIGITAL IDENTIFIER',
    just  = c('center', 'bottom'),
    x     = 0.5,
    y     = 0)
upViewport()

pushViewport(vpLL)
  grid.circle(
    x = c(.2, .4, .6, .8),
    y = rep(topCircleLabelY, 4),
    r = circleRadius)
  grid.text(
    label = paste0('URL ', 5:8),
    x     = c(.2, .4, .6, .8),
    y     = rep(topCircleLabelY, 4),
    gp    = gpar(cex = topCircleLabelCex))
  grid.circle(
    x = .5,
    y = .5,
    r = circleRadius)
  grid.text(
    label = 'D',
    x = .5,
    y = .5)
  grid.segments(
    x0 <- arrowUpperX(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = .5,
      lowerCircleCenterY = .5, 
      radius             = circleRadius),
    x1 <- arrowLowerX(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = .5,
      lowerCircleCenterY = .5, 
      radius             = circleRadius),
    y0 = arrowUpperY(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = .5,
      lowerCircleCenterY = .5, 
      radius             = circleRadius),
     y1 = arrowLowerY(
       upperCircleCenterX = c(.2, .4, .6, .8), 
       upperCircleCenterY = topCircleLabelY, 
       lowerCircleCenterX = .5,
       lowerCircleCenterY = .5, 
       radius             = circleRadius),
    arrow = arrow(
      angle  = 15, 
      length = arrowTipLength,
      type   = "closed"),
    gp    = gpar(fill = "black"))
  grid.circle(
    x = resourceCircleLabelX.L,
    y = resourceCircleLabelY.lower,
    r = circleRadius)
  grid.text(
    label = 'R',
    x     = resourceCircleLabelX.L,
    y     = resourceCircleLabelY.lower)

  # arrow from "D" to "R"
  grid.segments(
    x0 <- arrowUpperX(
      upperCircleCenterX = .5, 
      upperCircleCenterY = unit(.5, "npc"), 
      lowerCircleCenterX = resourceCircleLabelX.L,
      lowerCircleCenterY = resourceCircleLabelY.lower, 
      radius             = circleRadius),
    x1 <- arrowLowerX(
      upperCircleCenterX = .5, 
      upperCircleCenterY = unit(.5, "npc"), 
      lowerCircleCenterX = resourceCircleLabelX.L,
      lowerCircleCenterY = resourceCircleLabelY.lower, 
      radius             = circleRadius),
    y0 = arrowUpperY(
      upperCircleCenterX = .5, 
      upperCircleCenterY = unit(.5, "npc"), 
      lowerCircleCenterX = resourceCircleLabelX.L,
      lowerCircleCenterY = resourceCircleLabelY.lower, 
      radius             = circleRadius),
    y1 = arrowLowerY(
      upperCircleCenterX = .5, 
      upperCircleCenterY = unit(.5, "npc"), 
      lowerCircleCenterX = resourceCircleLabelX.L,
      lowerCircleCenterY = resourceCircleLabelY.lower, 
      radius             = circleRadius),
    arrow = arrow(
      angle  = 15, 
      length = arrowTipLength,
      type   = "closed"),
    gp    = gpar(fill = "black"))
upViewport()

pushViewport(vpLR)
  grid.circle(
    x = c(.2, .4, .6, .8),
    y = rep(topCircleLabelY, 4),
    r = circleRadius)
  grid.text(
    label = paste0('URL ', 5:8),
    x     = c(.2, .4, .6, .8),
    y     = rep(topCircleLabelY, 4),
    gp    = gpar(cex = topCircleLabelCex))
  grid.circle(
    x = .5,
    y = .5,
    r = circleRadius)
  grid.text(
    label = 'D',
    x = .5,
    y = .5)
  
  # Arrow from URL to "D"
  grid.segments(
    x0 <- arrowUpperX(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = .5,
      lowerCircleCenterY = .5, 
      radius             = circleRadius),
    x1 <- arrowLowerX(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = .5,
      lowerCircleCenterY = .5, 
      radius             = circleRadius),
    y0 = arrowUpperY(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = .5,
      lowerCircleCenterY = .5, 
      radius             = circleRadius),
    y1 = arrowLowerY(
      upperCircleCenterX = c(.2, .4, .6, .8), 
      upperCircleCenterY = topCircleLabelY, 
      lowerCircleCenterX = .5,
      lowerCircleCenterY = .5, 
      radius             = circleRadius),
    arrow = arrow(
      angle  = 15, 
      length = arrowTipLength,
      type   = "closed"),
      gp     = gpar(fill = "black"))
  grid.circle(
    x = resourceCircleLabelX.R,
    y = resourceCircleLabelY.lower,
    r = circleRadius)
  grid.text(
    label = 'R',
    x     = resourceCircleLabelX.R,
    y     = resourceCircleLabelY.lower)
  
  # Arrow from "D" to "R"
  grid.segments(
    x0 <- arrowUpperX(
      upperCircleCenterX = .5, 
      upperCircleCenterY = unit(.5, "npc"), 
      lowerCircleCenterX = resourceCircleLabelX.R,
      lowerCircleCenterY = resourceCircleLabelY.lower, 
      radius             = circleRadius),
    x1 <- arrowLowerX(
      upperCircleCenterX = .5, 
      upperCircleCenterY = unit(.5, "npc"), 
      lowerCircleCenterX = resourceCircleLabelX.R,
      lowerCircleCenterY = resourceCircleLabelY.lower, 
      radius             = circleRadius),
    y0 = arrowUpperY(
      upperCircleCenterX = .5, 
      upperCircleCenterY = unit(.5, "npc"), 
      lowerCircleCenterX = resourceCircleLabelX.R,
      lowerCircleCenterY = resourceCircleLabelY.lower, 
      radius             = circleRadius),
    y1 = arrowLowerY(
      upperCircleCenterX = .5, 
      upperCircleCenterY = unit(.5, "npc"), 
      lowerCircleCenterX = resourceCircleLabelX.R,
      lowerCircleCenterY = resourceCircleLabelY.lower, 
      radius             = circleRadius),
    arrow = arrow(
      angle  = 15, 
      length = arrowTipLength,
      type   = "closed"),
    gp    = gpar(fill = "black"))
upViewport()

pushViewport(vpL)
  grid.segments(
    x0 = changeStringArrowX.L,
    x1 = changeStringArrowX.R,
    y0 = resourceCircleLabelY.lower,
    y1 = resourceCircleLabelY.lower,
    arrow = arrow(
      angle  = 15, 
      length = arrowTipLength,
      type   = "closed"),
    gp = gpar(fill = "black"))
  grid.text(
    label = changeString,
    x     = .5,
    y     = resourceCircleLabelY.lower + changeStringSep,
    gp    = gpar(cex = changeStringCex))
upViewport()
upViewport()  # removing master layout 
dev.off()